home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / term / sun.el < prev    next >
Lisp/Scheme  |  1993-05-29  |  10KB  |  280 lines
  1. ;; sun.el --- keybinding for standard default sunterm keys
  2.  
  3. ;; Author: Jeff Peck <peck@sun.com>
  4. ;; Keywords: terminals
  5.  
  6. ;; Copyright (C) 1987 Free Software Foundation, Inc.
  7.  
  8. ;;; This file is part of GNU Emacs.
  9. ;;;
  10. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;;; it under the terms of the GNU General Public License as published by
  12. ;;; the Free Software Foundation; either version 2, or (at your option)
  13. ;;; any later version.
  14. ;;;
  15. ;;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;; GNU General Public License for more details.
  19. ;;;
  20. ;;; You should have received a copy of the GNU General Public License
  21. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; The function key sequences for the console have been converted for
  27. ;; use with function-key-map, but the *tool stuff hasn't been touched.
  28.  
  29. ;;; Code:
  30.  
  31. (defun ignore-key ()
  32.   "interactive version of ignore"
  33.   (interactive)
  34.   (ignore))
  35.  
  36. (defun scroll-down-in-place (n)
  37.   (interactive "p")
  38.   (previous-line n)
  39.   (scroll-down n))
  40.  
  41. (defun scroll-up-in-place (n)
  42.   (interactive "p")
  43.   (next-line n)
  44.   (scroll-up n))
  45.  
  46. (defun kill-region-and-unmark (beg end)
  47.   "Like kill-region, but pops the mark [which equals point, anyway.]"
  48.   (interactive "r")
  49.   (kill-region beg end)
  50.   (setq this-command 'kill-region-and-unmark)
  51.   (set-mark-command t))
  52.  
  53. (defun select-previous-complex-command ()
  54.   "Select Previous-complex-command"
  55.   (interactive)
  56.   (if (zerop (minibuffer-depth))
  57.       (repeat-complex-command 1)
  58.     (previous-complex-command 1)))
  59.  
  60. (defun rerun-prev-command ()
  61.   "Repeat Previous-complex-command."
  62.   (interactive)
  63.   (eval (nth 0 command-history)))
  64.  
  65. (defvar grep-arg nil "Default arg for RE-search")
  66. (defun grep-arg ()
  67.   (if (memq last-command '(research-forward research-backward)) grep-arg
  68.     (let* ((command (car command-history))
  69.        (command-name (symbol-name (car command)))
  70.        (search-arg (car (cdr command)))
  71.        (search-command 
  72.         (and command-name (string-match "search" command-name)))
  73.        )
  74.       (if (and search-command (stringp search-arg)) (setq grep-arg search-arg)
  75.     (setq search-command this-command 
  76.           grep-arg (read-string "REsearch: " grep-arg)
  77.           this-command search-command)
  78.     grep-arg))))
  79.  
  80. (defun research-forward ()
  81.   "Repeat RE search forward."
  82.   (interactive)
  83.   (re-search-forward (grep-arg)))
  84.  
  85. (defun research-backward ()
  86.   "Repeat RE search backward."
  87.   (interactive)
  88.   (re-search-backward (grep-arg)))
  89.  
  90. ;;;
  91. ;;; handle sun's extra function keys
  92. ;;; this version for those who run with standard .ttyswrc and no emacstool
  93. ;;;
  94. ;;; sunview picks up expose and open on the way UP, 
  95. ;;; so we ignore them on the way down
  96. ;;;
  97.  
  98. (defvar sun-esc-bracket nil
  99.   "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
  100.  
  101. (define-prefix-command 'sun-raw-prefix)
  102. (define-key function-key-map "\e[" 'sun-raw-prefix)
  103.  
  104. (define-key sun-raw-prefix "210z" [r3])
  105. (define-key sun-raw-prefix "213z" [r6])
  106. (define-key sun-raw-prefix "214z" [r7])
  107. (define-key sun-raw-prefix "216z" [r9])
  108. (define-key sun-raw-prefix "218z" [r11])
  109. (define-key sun-raw-prefix "220z" [r13])
  110. (define-key sun-raw-prefix "222z" [r15])
  111. (define-key sun-raw-prefix "193z" [redo])
  112. (define-key sun-raw-prefix "194z" [props])
  113. (define-key sun-raw-prefix "195z" [undo])
  114. ; (define-key sun-raw-prefix "196z" 'ignore-key)        ; Expose-down
  115. ; (define-key sun-raw-prefix "197z" [put])
  116. ; (define-key sun-raw-prefix "198z" 'ignore-key)        ; Open-down
  117. ; (define-key sun-raw-prefix "199z" [get])
  118. (define-key sun-raw-prefix "200z" [find])
  119. ; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark)    ; Delete
  120. (define-key sun-raw-prefix "226z" [t3])
  121. (define-key sun-raw-prefix "227z" [t4])
  122. (define-key sun-raw-prefix "229z" [t6])
  123. (define-key sun-raw-prefix "230z" [t7])
  124. (define-key sun-raw-prefix "A" [up])            ; R8
  125. (define-key sun-raw-prefix "B" [down])            ; R14
  126. (define-key sun-raw-prefix "C" [right])            ; R12
  127. (define-key sun-raw-prefix "D" [left])            ; R10
  128.  
  129. (global-set-key [r3]    'backward-page)
  130. (global-set-key [r6]    'forward-page)
  131. (global-set-key [r7]    'beginning-of-buffer)
  132. (global-set-key [r9]    'scroll-down)
  133. (global-set-key [r11]    'recenter)
  134. (global-set-key [r13]    'end-of-buffer)
  135. (global-set-key [r15]    'scroll-up)
  136. (global-set-key [redo]    'redraw-display)
  137. (global-set-key [props]    'list-buffers)
  138. (global-set-key [undo]    'undo)
  139. (global-set-key [put]    'sun-select-region)
  140. (global-set-key [get]    'sun-yank-selection)
  141. (global-set-key [find]    'exchange-point-and-mark)
  142. (global-set-key [t3]    'scroll-down-in-place)
  143. (global-set-key [t4]    'scroll-up-in-place)
  144. (global-set-key [t6]    'shrink-window)
  145. (global-set-key [t7]    'enlarge-window)
  146.  
  147.  
  148. (if sun-esc-bracket (global-unset-key "\e["))
  149.  
  150. ;;; Since .emacs gets loaded before this file, a hook is supplied
  151. ;;; for you to put your own bindings in.
  152.  
  153. (defvar sun-raw-prefix-hooks nil
  154.   "List of forms to evaluate after setting sun-raw-prefix.")
  155.  
  156. (let ((hooks sun-raw-prefix-hooks))
  157.   (while hooks
  158.     (eval (car hooks))
  159.     (setq hooks (cdr hooks))
  160.     ))
  161.  
  162.  
  163. ;;; This section adds definitions for the emacstool users
  164. ;;; emacstool event filter converts function keys to C-x*{c}{lrt}
  165. ;;;
  166. ;;; for example the Open key (L7) would be encoded as "\C-x*gl"
  167. ;;; the control, meta, and shift keys modify the character {lrt}
  168. ;;; note that (unshifted) C-l is ",",  C-r is "2", and C-t is "4"
  169. ;;;
  170. ;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT.
  171. ;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys)
  172. ;;; as ANSI escape sequences.  Use the shell command 
  173. ;;; % setkeys noarrows
  174. ;;; if you want these to come through for emacstool.
  175. ;;;
  176. ;;; If you are not using EmacsTool, 
  177. ;;; you can also use this by creating a .ttyswrc file to do the conversion.
  178. ;;; but it won't include the CONTROL, META, or SHIFT keys!
  179. ;;;
  180. ;;; Important to define SHIFTed sequence before matching unshifted sequence.
  181. ;;; (talk about bletcherous old uppercase terminal conventions!*$#@&%*&#$%)
  182. ;;;  this is worse than C-S/C-Q flow control anyday!
  183. ;;;  Do *YOU* run in capslock mode?
  184. ;;;
  185.  
  186. ;;; Note:  al, el and gl are trapped by EmacsTool, so they never make it here.
  187.  
  188. (defvar meta-flag t)
  189.  
  190. (defvar suntool-map (make-sparse-keymap)
  191.   "*Keymap for Emacstool bindings.")
  192.  
  193. (define-key suntool-map "gr" 'beginning-of-buffer)    ; r7
  194. (define-key suntool-map "iR" 'backward-page)        ; R9
  195. (define-key suntool-map "ir" 'scroll-down)        ; r9
  196. (define-key suntool-map "kr" 'recenter)            ; r11
  197. (define-key suntool-map "mr" 'end-of-buffer)        ; r13
  198. (define-key suntool-map "oR" 'forward-page)        ; R15
  199. (define-key suntool-map "or" 'scroll-up)        ; r15
  200. (define-key suntool-map "b\M-L" 'rerun-prev-command)    ; M-AGAIN
  201. (define-key suntool-map "b\M-l" 'prev-complex-command)    ; M-Again
  202. (define-key suntool-map "bl" 'redraw-display)        ; Again
  203. (define-key suntool-map "cl" 'list-buffers)        ; Props
  204. (define-key suntool-map "dl" 'undo)            ; Undo
  205. (define-key suntool-map "el" 'ignore-key)        ; Expose-Open
  206. (define-key suntool-map "fl" 'sun-select-region)    ; Put
  207. (define-key suntool-map "f," 'copy-region-as-kill)    ; C-Put
  208. (define-key suntool-map "gl" 'ignore-key)        ; Open-Open
  209. (define-key suntool-map "hl" 'sun-yank-selection)    ; Get
  210. (define-key suntool-map "h," 'yank)            ; C-Get
  211. (define-key suntool-map "il" 'research-forward)        ; Find
  212. (define-key suntool-map "i," 're-search-forward)    ; C-Find
  213. (define-key suntool-map "i\M-l" 'research-backward)    ; M-Find
  214. (define-key suntool-map "i\M-," 're-search-backward)    ; C-M-Find
  215.  
  216. (define-key suntool-map "jL" 'yank)            ; DELETE        
  217. (define-key suntool-map "jl" 'kill-region-and-unmark)    ; Delete
  218. (define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete
  219. (define-key suntool-map "j," 
  220.   '(lambda () (interactive) (pop-mark 1)))        ; C-Delete
  221.  
  222. (define-key suntool-map "fT" 'shrink-window-horizontally)    ; T6
  223. (define-key suntool-map "gT" 'enlarge-window-horizontally)    ; T7
  224. (define-key suntool-map "ft" 'shrink-window)            ; t6
  225. (define-key suntool-map "gt" 'enlarge-window)            ; t7
  226. (define-key suntool-map "cT" '(lambda(n) (interactive "p") (scroll-down n)))
  227. (define-key suntool-map "dT" '(lambda(n) (interactive "p") (scroll-up n)))
  228. (define-key suntool-map "ct" 'scroll-down-in-place)        ; t3
  229. (define-key suntool-map "dt" 'scroll-up-in-place)        ; t4
  230. (define-key ctl-x-map "*" suntool-map)
  231.  
  232. ;;; Since .emacs gets loaded before this file, a hook is supplied
  233. ;;; for you to put your own bindings in.
  234.  
  235. (defvar suntool-map-hooks nil
  236.   "List of forms to evaluate after setting suntool-map.")
  237.  
  238. (let ((hooks suntool-map-hooks))
  239.   (while hooks
  240.     (eval (car hooks))
  241.     (setq hooks (cdr hooks))
  242.     ))
  243.  
  244. ;;;
  245. ;;; If running under emacstool, arrange to call suspend-emacstool
  246. ;;; instead of suspend-emacs.
  247. ;;;
  248. ;;; First mouse blip is a clue that we are in emacstool.
  249. ;;;
  250. ;;; C-x C-@ is the mouse command prefix.
  251.  
  252. (autoload 'sun-mouse-handler "sun-mouse" 
  253.       "Sun Emacstool handler for mouse blips (not loaded)." t)
  254.  
  255. (defun emacstool-init ()
  256.   "Set up Emacstool window, if you know you are in an emacstool."
  257.   ;; Make sure sun-mouse and sun-fns are loaded.
  258.   (require 'sun-fns)
  259.   (define-key ctl-x-map "\C-@" 'sun-mouse-handler)
  260.  
  261.   (if (< (sun-window-init) 0)
  262.       (message "Not a Sun Window")
  263.     (progn
  264.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map)
  265.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map)
  266.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map))
  267.       (send-string-to-terminal
  268.        (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\"))
  269.     ))
  270.  
  271. (defun sun-mouse-once ()
  272.   "Converts to emacstool and sun-mouse-handler on first mouse hit."
  273.   (interactive)
  274.   (emacstool-init)
  275.   (sun-mouse-handler)            ; Now, execute this mouse blip.
  276.   )
  277. (define-key ctl-x-map "\C-@" 'sun-mouse-once)
  278.  
  279. ;;; sun.el ends here
  280.